Crack It!/Crack It!.iso/CONTENT/DISKEDIT/MENURT.PAS

Pascal/Delphi Source File | 1996-09-09 | 8KB | 282 lines

{
 ***

 MENURT.PAS
 Menu Interface Unit
 (C)Copyright Gerard Paul Java 1996

 This unit implements an object-oriented menu.

 ***
}

unit MenuRt;

interface

type
  ItemNameType = string[30];
  ItemDescType = string[60];

  ShortCutKeysType = string[20];

  ItemPtrType = ^ItemRec;
  ItemRec = record
              Name: ItemNameType;
              Description: ItemDescType;
              Prev,Next: ItemPtrType;
            end;

  MenuType = object
               ItemList: ItemPtrType;
               LastNodeAdded: ItemPtrType;
               SelectedItemPtr: ItemPtrType;
               ShortCutKeys: ShortCutKeysType;
               ItemCount: byte;
               MenuX: byte;
               MenuY: byte;
               lWinPos: byte;
               uWinPos: byte;
               rWinPos: byte;
               dWinPos: byte;
               procedure Init;
               procedure SetScreenPos(xPos,yPos: byte);
               procedure AddItem(Name: ItemNameType;
                                 Description: ItemDescType);
               procedure Show;
               procedure Operate(var Postn: byte;
                                 var HelpSignal: boolean);
               procedure DisposeMenu;
             end;

var
  NormOptKeyAttr: byte;
  OptionNormTextAttr: byte;
  SelectedOptKeyAttr: byte;
  OptionSelectedTextAttr: byte;
  HelpLineTextAttr: byte;

implementation
uses Crt,ScreenRt,SysRt;

const
  NotSelected = False;
  Selected = True;

procedure MenuType.Init;
begin
  ItemCount := 0;
  ShortCutKeys := '';
  ItemList := nil;
end;

procedure MenuType.SetScreenPos;
begin
  MenuX := xPos;
  MenuY := yPos;
  lWinPos := MenuX+1;
  uWinPos := MenuY+1;
  rWinPos := MenuX+30;
  dWinPos := MenuY+ItemCount;

  SelectedItemPtr := ItemList;
end;

procedure MenuType.AddItem;
var
  tItemNode: ItemPtrType;

begin
  New(tItemNode);

  tItemNode^.Name := Name;
  tItemNode^.Description := Description;

  if ItemList = nil then
    ItemList := tItemNode
  else
    begin
      tItemNode^.Prev := LastNodeAdded;
      LastNodeAdded^.Next := tItemNode;
    end;

  tItemNode^.Next := ItemList;
  ItemList^.Prev := tItemNode;
  LastNodeAdded := tItemNode;
  Inc(ItemCount);

  ShortCutKeys := ShortCutKeys+
                  UpCase(tItemNode^.Name[Pos('^',tItemNode^.Name)+1]);
end;

procedure DisplayMenuItem(var ItemName: ItemNameType;IsSelected: boolean);
var
  MarkerPos: byte;
  ItemLength: byte;
  HighAttr,
  OptionLoAttr: byte;

begin { proc }
  MarkerPos := Pos(KeyMarker,ItemName);       { Determine position of key letter. }

  case IsSelected of
    NotSelected:  begin
                    HighAttr := NormOptKeyAttr;
                    OptionLoAttr := OptionNormTextAttr;
                  end;
    Selected: begin
                HighAttr := SelectedOptKeyAttr;
                OptionLoAttr := OptionSelectedTextAttr;
              end;
  end;

  ItemLength := Length(ItemName);     { Record item length. }
  TextAttr := OptionLoAttr;Write(Space+Copy(ItemName,1,MarkerPos-1));
  TextAttr := HighAttr;Write(ItemName[MarkerPos+1]);
  TextAttr := OptionLoAttr;Write(Copy(ItemName,MarkerPos+2,ItemLength-MarkerPos));
  ClrEol;
end; { proc }

procedure DescribeMenuItem(var Description: ItemDescType);
begin
  Window(2,24,62,25);
  TextAttr := HelpLineTextAttr;Write(Description);
  ClrEol;
end; { proc }

procedure MenuType.Show;
var
  ItemCtr: byte;
  AuxItemPtr: ItemPtrType;

begin
  Window(1,1,80,25);

  TextAttr := HelpLineTextAttr;GotoXY(1,24);ClrEol;

  TextAttr := BoxAttr;
  DrawBox(MenuX,MenuY,MenuX+31,MenuY+ItemCount+1,DoubleLine);

  Window(lWinPos,uWinPos,rWinPos,dWinPos);

  AuxItemPtr := ItemList;

  for ItemCtr := 1 to ItemCount do
    begin
      GotoXY(1,ItemCtr);DisplayMenuItem(AuxItemPtr^.Name,NotSelected);
      AuxItemPtr := AuxItemPtr^.Next;
    end;
end;

procedure MenuType.Operate;
var
  Keystroke: char;
  ShortCutKeyPos: byte;
  TerminateLoop: boolean;
  AuxItemPtr: ItemPtrType;
  ItemCtr: byte;

procedure GotoItem(Postn: byte;var tNode: ItemPtrType);
var
  ItemCtr: byte;

begin
  ItemCtr := 1;
  tNode := ItemList;

  while ItemCtr <> Postn do
    begin
      tNode := tNode^.Next;
      Inc(ItemCtr);
    end;
end;

begin
  Window(lWinPos,uWinPos,rWinPos,dWinPos);

  GotoItem(Postn,SelectedItemPtr);

  AuxItemPtr := SelectedItemPtr;
  HelpSignal := False;
  TerminateLoop := False;

  repeat
    GotoXY(1,Postn);DisplayMenuItem(SelectedItemPtr^.Name,Selected);
    DescribeMenuItem(SelectedItemPtr^.Description);
    Window(lWinPos,uWinPos,rWinPos,dWinPos);

    Keystroke := UpCase(ReadKey);

    GotoXY(1,Postn);DisplayMenuItem(SelectedItemPtr^.Name,NotSelected);

    case Keystroke of                            { Check character entered. }
      ExtKey                  : case ReadKey of     { Extended key pressed. }
                                  F1       : begin
                                               HelpSignal := True;
                                               TerminateLoop := True;
                                             end;
                                  HomeKey  : begin
                                               Postn := 1;
                                               SelectedItemPtr := ItemList;
                                             end;
                                  EndKey   : begin
                                               Postn := ItemCount;
                                               SelectedItemPtr := LastNodeAdded;
                                             end;
                                  UpKey    : begin
                                               Dec(Postn);
                                               if Postn < 1 then
                                                 Postn := ItemCount;

                                               SelectedItemPtr := SelectedItemPtr^.Prev;
                                             end; { UpKey }
                                  DownKey  : begin
                                               Inc(Postn);
                                               if Postn > ItemCount then
                                                 Postn := 1;

                                               SelectedItemPtr := SelectedItemPtr^.Next;
                                             end; { DownKey }
                                end;  { case #0 }
      Enter: TerminateLoop := True;
      Esc,AltExitKey: begin
                        Postn := 0;
                        TerminateLoop := True;
                      end;
      else
        begin
          ShortCutKeyPos := Pos(Keystroke,ShortCutKeys);
          if ShortCutKeyPos <> 0 then
            begin
              Postn := ShortCutKeyPos;

              GotoItem(Postn,SelectedItemPtr);

              TerminateLoop := True;
            end;
        end;
    end; { case not #0 }
  until TerminateLoop;
end; { proc }

procedure MenuType.DisposeMenu;
var
  AuxItemPtr1: ItemPtrType;
  AuxItemPtr2: ItemPtrType;

begin
  AuxItemPtr1 := ItemList;
  AuxItemPtr2 := ItemList^.Next;

  repeat
    Dispose(AuxItemPtr1);
    AuxItemPtr1 := AuxItemPtr2;

    if AuxItemPtr2 <> nil then
      AuxItemPtr2 := AuxItemPtr2^.Next;
  until AuxItemPtr1 = nil;
end;

end.